\ 4tH SRT subtitle time shift - Copyright 2012,2013 J.L. Bezemer
\ You can redistribute this file and/or modify it under
\ the terms of the GNU General Public License

include lib/leading.4th                \ for -LEADING
include lib/getopts.4th                \ for GET-OPTIONS
include lib/argopen.4th                \ for ARG-OPEN
include lib/utf8.4th                   \ for PUTWCH
include lib/ulcase.4th                 \ for S>LOWER

char : constant ':'                    \ character :
char , constant ','                    \ character ,
char . constant '.'                    \ character .

3600000 constant hours                 \ an hour in ms
  60000 constant mins                  \ a minute in ms
   1000 constant secs                  \ a second in ms

0 value seq#                           \ sequence number
0 value (shift)                        \ shift in milliseconds

:noname emit ; is putch                \ map EMIT to PUTCH
:noname type ; is (type)               \ map TYPE to (TYPE)

: parse+trim parse -leading -trailing ;
: length? 0 parse+trim nip ;           ( -- len)
: zero? length? 0= ;                   ( -- f)
: (empty) 0  begin drop refill dup while drop dup execute dup until nip ;
: skip-empty ['] length? (empty) ;     ( -- f)
: scan-empty ['] zero? (empty) ;       ( -- f)
: --> bl parse+trim s" -->" compare abort" Arrow expected" ;
: num> parse+trim number error? abort" Number expected" ;
: :00 # 6 base ! # decimal ':' hold ;
: .timestamp <# # # # ',' hold :00 :00 # # #> type ;
: timestamp> ':' num> hours * ':' num> mins * + ',' num> secs * + bl num> + ;
: +shift (shift) + dup 0< ;            ( n -- n+s f)
: skip-subtitle drop drop scan-empty 0= abort" Unexpected end of file" ;
                                       \ write the payload
: .payload                             ( --)
  begin
    refill                             \ get a line
  while                                \ if not end of file
    0 parse+trim dup                   \ check for subtitle
    if (type) cr else 2drop exit then  \ if a subtitle is there print it
  repeat                               \ otherwise return
;
                                       \ parse a subtitle sequence
: parse-subtitle                       ( n1 n2 --)
  seq# 1+ dup to seq# 0 .r cr          \ increase sequence and print it
  .timestamp ."  --> " .timestamp cr   \ rewrite the timestamp
  .payload cr                          \ print the payload
;
                                       \ rewrite all subtitles
: subtitle                             ( --)
  begin
    skip-empty                         \ skip empty lines
  while                                \ if not EOF
    refill 0= abort" Time stamp expected"
    timestamp> --> timestamp> +shift >r swap +shift r> or
    if skip-subtitle else parse-subtitle then
  repeat                               \ rewrite subtitle or skip subtitle
;

: set-lower                            \ set lowercase conversion
  2dup chop s>lower 1- chars + c@ is-alnum >r type r> if '.' emit then
;
                                       \ set UTF8 conversion
: set-utf8 bounds ?do i c@ putwch loop ;

create modes                           \ table with conversion modes
  ' set-utf8     ,                     \ UTF-8 conversion
  ' set-lower    ,                     \ lowercase conversion
  here modes 1 + - constant #modes
                                       \ get output mode
: get-conversion                       ( --)
  get-argument number error? abort" 'mode' must be a positive number"
  0 max #modes min cells modes + @c is (type)
;
                                       \ get time shift
: get-shift                            ( --)
  get-argument number error? abort" 'ms' must be a number" to (shift)
;
                                       \ options list
create options
  char s , ' get-shift ,
  char c , ' get-conversion ,
  NULL ,
                                       \ get arguments and handle files
: shift-subtitle                       ( --)
  options get-options option-index dup 2 + argn >
  abort" Usage: srtshift -c mode -s milliseconds infile outfile"
  input over arg-open output rot 1+ arg-open subtitle close close
;

shift-subtitle
